home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
mpfeel.lha
/
MPFeel
/
Modules
/
macros0.em
< prev
next >
Wrap
Lisp/Scheme
|
1992-10-07
|
2KB
|
87 lines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; EuLisp Module - Copyright (C) Codemist and University of Bath 1990 ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Change Log:
;; Version 1.0
;;
(defmodule macros0
(ccc lists list-operators others arith) ()
;; The compiler syntax is a little different...
(deflocal *defs-compile-time* ())
(defun compile-time-p ()
*defs-compile-time*)
((setter setter) compile-time-p
(lambda (x) (setq *defs-compile-time* x)))
(export compile-time-p)
;; Control Extentions - Conditional Extentions
(defmacro cond b
(if b (if (cdr (car b)) (list 'if (car (car b)) (cons 'progn (cdr (car b)))
(cons 'cond (cdr b)))
(list 'or (car (car b)) (cons 'cond (cdr b))))
()))
;; Control Extentions - Binding extentions
;; LET expands to LAMBDA
(defmacro let (bind . body)
(cons (cons 'lambda (cons (\@letvars bind) body)) (\@letforms bind)))
(defun \@letvars (b)
(if b (cons (car (car b)) (\@letvars (cdr b)))
()))
(defun \@letforms (b)
(if b (cons (car (cdr (car b))) (\@letforms (cdr b)))
()))
;; LET* expands to LET
(defmacro let* (bind . body)
(if bind (list 'let (cons (car bind) ())
(cons 'let* (cons (cdr bind) body)))
(cons 'progn body)))
;; LABELS is a complex LET
(defmacro labels (binds . body)
(cons 'let (cons (\@labelsvar binds) (\@labelsbody binds body))))
(defun \@labelsvar (b)
(if b (cons (list (car (car b)) ()) (\@labelsvar (cdr b)))
()))
(defun \@labelsbody (b body)
(if b (cons (list 'setq (car (car b)) (cons 'lambda (cdr (car b))))
(\@labelsbody (cdr b) body))
body))
(defmacro and b
(if b (if (cdr b) (list 'if (car b) (cons 'and (cdr b)) ())
(car b))
t))
(defmacro or b
(if b
(if (cdr b) (list 'let (list (list '\@ (car b)))
(list 'if '\@ '\@ (cons 'or (cdr b))))
(car b))
()))
(defmacro when (pred . forms) `(if ,pred (progn ,@forms) nil))
(defmacro unless (pred . forms) `(if ,pred nil (progn ,@forms)))
(export let let* cond and or when unless labels)
)